;; core/lambdaS.scm - (c) rohan drape, 2000-2005

;; NOTE: The notation for a value is (~ x).

(define-syntax letS
  (syntax-rules (~)
    ((_ (((n) (~ v))) expr ...)
     (let ((n v)) expr ...))
    ((_ (((n ...) (t v))) expr ...)
     (match v 
	    ((struct t (n ...)) expr ...)
	    (else (error "letS" (quote (n ...)) (quote t) v))))
    ((_ (((n1 ...) (t1 v1)) ((n2 ...) (t2 v2)) ...) expr ...)
     (letS (((n1 ...) (t1 v1))) (letS (((n2 ...) (t2 v2)) ...) expr ...)))))

;; Variant <function> constructor.  The arguments are given as
;; structures.  For none structure arguments write (value name).

(define-syntax lambdaS
  (syntax-rules ()
    ((_ ((type name ...)) expr ...)
     (lambda (value) 
       (letS (((name ...) (type value))) 
	 expr ...)))
    ((_ ((t1 n1 ...) (t2 n2 ...)) x ...)
     (lambda (v1 v2) 
       (letS (((n1 ...) (t1 v1)) ((n2 ...) (t2 v2))) 
	 x ...)))
    ((_ ((t1 n1 ...) (t2 n2 ...) (t3 n3 ...)) x ...)
     (lambda (v1 v2 v3) 
       (letS (((n1 ...) (t1 v1)) ((n2 ...) (t2 v2)) ((n3 ...) (t3 v3))) 
	 x ...)))))

(define-syntax defineS
  (syntax-rules ()
    ((_ (binding name ...) expr ...)
     (define binding (lambdaS (name ...) expr ...)))))

